home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
XMSLI202.ZIP
/
XMSDEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-03-17
|
6KB
|
178 lines
Program XMSLibDemo;
{ Copyright (c) 1994 by Andrew Eigus Fido Net: 2:5100/20.12 }
{ XMS Interface V2.02 for Turbo Pascal version 7.0 demonstration program }
(*
Tested on IBM 486 SX 33Mhz with 4MB RAM with the following configuration:
1) HIMEM.SYS (MS-DOS 6.2 XMS memory manager)
2) HIMEM.SYS (MS-DOS 6.2 XMS memory manager)
EMM386.EXE (MS-DOS 6.2 EMS memory manager)
If any inpredictable errors occur in your system while running this demo,
please be so kind to inform me:
AndRew's BBS Phone: 003-712-559777 (Riga, Latvia) 24h 2400bps
Voice Phone: 003-712-553218
Fido Net: 2:5100/20.12
*)
{X+}{$R-}
uses XMSLib;
type
TMsg = array[1..14] of Char;
TUMBAllocRec = record
Size : word;
SegAddr : word
end;
const
Message1 : TMsg = 'First message ';
Message2 : TMsg = 'Second message';
YesNo : array[boolean] of string[3] = ('No', 'Yes');
A20State : array[boolean] of string[8] = ('Disabled', 'Enabled');
var
Version, Memory, Handle, BlockLength : word;
Locks, FreeHandles : byte;
HMAAvailable : boolean;
Address : pointer;
UMB : longint;
Function Hex(Num : longint; Places : byte) : string;
const HexTab : array[0..15] of Char = '0123456789ABCDEF';
var
HS : string[8];
Digit : byte;
Begin
HS[0] := Chr(Places);
for Digit := Places downto 1 do
begin
HS[Digit] := HexTab[Num and $0000000F];
Num := Num shr 4
end;
Hex := HS
End; { Hex }
Function Check(Result : byte; Func : string) : byte;
Begin
if Result <> xmsrOk then
WriteLn(Func, ' returned ',
Hex(Result, 2), 'h (', Result, '): ', XMS_GetErrorMsg(Result));
Check := Result
End; { Check }
Procedure ShowA20State;
var State : boolean;
Begin
State := XMS_QueryA20;
if Check(XMSResult, 'XMS_QueryA20') = xmsrOk then
WriteLn('A20 state: ', A20State[State])
End; { ShowA20State }
Procedure Wait4Return;
Begin
WriteLn;
WriteLn('Press ENTER to continue');
ReadLn
end; { Wait4Return }
Begin
WriteLn('XMS Library V2.02 Demonstration program by Andrew Eigus'#10);
if XMS_Setup then
begin
Version := XMS_GetVersion(XMS);
if Check(XMSResult, 'XMS_GetVersion(XMS)') = xmsrOk then
WriteLn('XMS version ', Hi(Version), '.', Lo(Version), ' present');
Version := XMS_GetVersion(XMM);
if Check(XMSResult, 'XMS_GetVersion(XMM)') = xmsrOk then
WriteLn('XMM version ', Hi(Version), '.', Lo(Version), ' detected');
HMAAvailable := XMS_HMAAvail;
if Check(XMSResult, 'XMS_HMAAvail') = xmsrOk then
WriteLn('HMA Available: ', YesNo[HMAAvailable]);
WriteLn;
Memory := XMS_MemAvail;
if Check(XMSResult, 'XMS_MemAvail') = xmsrOk then
WriteLn('Free XMS memory available: ', Memory, ' KB')
else
if XMSResult = xmsrNoMoreMem then Halt(xmsrNoMoreMem);
Memory := XMS_MaxAvail;
if Check(XMSResult, 'XMS_MaxAvail') = xmsrOk then
WriteLn('Largest XMS memory block: ', Memory, ' KB');
WriteLn;
if HMAAvailable then
if Check(XMS_AllocHMA($FFFF), 'XMS_AllocHMA') = xmsrOk then
begin
WriteLn('HMA: Block allocated');
if Check(XMS_FreeHMA, 'XMS_FreeHMA') = xmsrOk then
WriteLn('HMA: Block released')
end;
Wait4Return;
WriteLn('XMS data transfer test'#10);
WriteLn('Message1: ', Message1);
WriteLn('Message2: ', Message2);
Handle := XMS_AllocEMB(1);
if Check(XMSResult, 'XMS_AllocEMB') = xmsrOk then
begin
WriteLn('1 KB EMB allocated. Handle number: ', Hex(Handle, 4), 'h');
{ Now copy our little Message1 to extended memory }
if Check(XMS_MoveToEMB(Handle, Message1, SizeOf(TMsg)),
'XMS_MoveToEMB') = xmsrOk then WriteLn('Transfer to XMS: OK');
{ Now copy it back to the second string }
if Check(XMS_MoveFromEMB(Handle, Message2, SizeOf(TMsg)),
'XMS_MoveFromEMB') = xmsrOk then WriteLn('Transfer from XMS: OK');
WriteLn('Message1: ', Message1);
WriteLn('Message2: ', Message2);
WriteLn;
if Check(XMS_ReallocEMB(Handle, 2),
'XMS_ReallocEMB') = xmsrOk then
WriteLn('EMB reallocated. New size: 2 KB');
WriteLn;
Address := XMS_LockEMB(Handle);
if Check(XMSResult, 'XMS_LockEMB') = xmsrOk then
WriteLn('EMB locked at linear memory address ',
Hex(Longint(Address), 8), 'h');
WriteLn;
FreeHandles := XMS_EMBHandlesAvail(Handle);
if Check(XMSResult, 'XMS_EMBHandlesAvail') = xmsrOk then
WriteLn('EMB Handles available: ', FreeHandles);
Locks := XMS_EMBLockCount(Handle);
if Check(XMSResult, 'XMS_EMBLockCount') = xmsrOk then
WriteLn('EMB Lock count: ', Locks);
BlockLength := XMS_EMBSize(Handle);
if Check(XMSResult, 'XMS_EMBSize') = xmsrOk then
WriteLn('EMB Length: ', BlockLength, ' KB');
WriteLn;
if Check(XMS_UnlockEMB(Handle), 'XMS_UnlockEMB') = xmsrOk then
WriteLn('EMB unlocked');
WriteLn;
if Check(XMS_FreeEMB(Handle), 'XMS_FreeEMB') = xmsrOk then
WriteLn('EMB released');
Wait4Return
end;
UMB := XMS_AllocUMB($FFFF);
if Check(XMSResult, 'XMS_AllocUMB') = xmsrOk then
begin
WriteLn('UMB allocated at segment base ',
Hex(TUMBAllocRec(UMB).SegAddr, 4), 'h');
WriteLn('Actual size: ', TUMBAllocRec(UMB).Size, ' paragraphs'#10);
if Check(XMS_FreeUMB(TUMBAllocRec(UMB).SegAddr),
'XMS_FreeUMB') = xmsrOk then WriteLn('UMB released')
end;
end else WriteLn('XMS not present.')
End.